Logistična regresija
podatki <- read.table("/cloud/project/Poglavje 3/Naloga 1/Srčni zastoj.csv", header=TRUE, sep=";", dec=",")
head(podatki)## ID Zastoj Starost Spol Aktivnost Kadilec Holesterol Zdravilo
## 1 1 0 52 1 1 0 0 2
## 2 2 1 68 0 1 0 1 0
## 3 3 1 66 1 1 1 0 1
## 4 4 1 70 0 1 0 1 1
## 5 5 0 51 0 0 1 0 2
## 6 6 1 63 0 0 0 0 1Opis spremenljivk:
- ID: ID osebe
- Zastoj: Ponovitev srčnega zastoja (0:NE, 1:DA)
- Starost: Starost v letih ob začetku študije
- Spol: 0:M, 1:Ž
- Aktivnost: Redna športna aktivnost (0:NE, 1:DA)
- Kadilec: 0:NE, 1:DA
- Holesterol: Ali ima oseba povišan holesterol? (0:NE, 1:DA)
- Zdravilo: Vrsta zdravila, ki ga oseba prejema (0:Placebo, 1:Zdravilo A, 2:Zdravilo B)
podatki$ZastojFaktor <- factor(podatki$Zastoj,
levels = c(0, 1),
labels = c("NE", "DA"))
podatki$SpolFaktor <- factor(podatki$Spol,
levels = c(0, 1),
labels = c("M", "Ž"))
podatki$AktivnostFaktor <- factor(podatki$Aktivnost,
levels = c(0, 1),
labels = c("NE", "DA"))
podatki$KadilecFaktor <- factor(podatki$Kadilec,
levels = c(0, 1),
labels = c("NE", "DA"))
podatki$HolesterolFaktor <- factor(podatki$Holesterol,
levels = c(0, 1),
labels = c("NE", "DA"))
podatki$ZdraviloFaktor <- factor(podatki$Zdravilo,
levels = c(0, 1, 2),
labels = c("Placebo", "Zdravilo A", "Zdravilo B"))summary(podatki[ , c(-1, -2, -4, -5, -6, -7, -8)]) #Opisna statistika za izbrane spremenljivke## Starost ZastojFaktor SpolFaktor AktivnostFaktor
## Min. :45.00 NE:1168 M:1203 NE:1178
## 1st Qu.:55.00 DA:1253 Ž:1218 DA:1243
## Median :61.00
## Mean :61.89
## 3rd Qu.:68.00
## Max. :88.00
## KadilecFaktor HolesterolFaktor ZdraviloFaktor
## NE:1942 NE:1460 Placebo : 731
## DA: 479 DA: 961 Zdravilo A: 652
## Zdravilo B:1038
##
##
## fit0 <- glm(ZastojFaktor ~ 1,
family = binomial,
data = podatki)
summary(fit0)##
## Call:
## glm(formula = ZastojFaktor ~ 1, family = binomial, data = podatki)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.207 -1.207 1.148 1.148 1.148
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 0.07025 0.04067 1.727 0.0841 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3353.2 on 2420 degrees of freedom
## Residual deviance: 3353.2 on 2420 degrees of freedom
## AIC: 3355.2
##
## Number of Fisher Scoring iterations: 3exp(cbind(obet = fit0$coefficients, confint.default(fit0)))## obet 2.5 % 97.5 %
## (Intercept) 1.072774 0.9905759 1.161793head(fitted(fit0)) ## 1 2 3 4 5 6
## 0.5175547 0.5175547 0.5175547 0.5175547 0.5175547 0.5175547fit1 <- glm(ZastojFaktor ~ Starost + SpolFaktor + AktivnostFaktor + KadilecFaktor +
HolesterolFaktor,
family = binomial,
data = podatki)
summary(fit1)##
## Call:
## glm(formula = ZastojFaktor ~ Starost + SpolFaktor + AktivnostFaktor +
## KadilecFaktor + HolesterolFaktor, family = binomial, data = podatki)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.5945 -1.1681 0.8871 1.1563 1.3701
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.963815 0.299098 -3.222 0.001271 **
## Starost 0.017071 0.004604 3.708 0.000209 ***
## SpolFaktorŽ -0.027714 0.082182 -0.337 0.735947
## AktivnostFaktorDA -0.193752 0.082344 -2.353 0.018625 *
## KadilecFaktorDA 0.523178 0.104983 4.983 6.25e-07 ***
## HolesterolFaktorDA -0.025263 0.083929 -0.301 0.763407
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3353.2 on 2420 degrees of freedom
## Residual deviance: 3307.1 on 2415 degrees of freedom
## AIC: 3319.1
##
## Number of Fisher Scoring iterations: 4fit2 <- glm(ZastojFaktor ~ Starost + SpolFaktor + AktivnostFaktor + KadilecFaktor +
HolesterolFaktor + ZdraviloFaktor,
family = binomial,
data = podatki)
summary(fit2)##
## Call:
## glm(formula = ZastojFaktor ~ Starost + SpolFaktor + AktivnostFaktor +
## KadilecFaktor + HolesterolFaktor + ZdraviloFaktor, family = binomial,
## data = podatki)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.6600 -1.1690 0.8789 1.1541 1.4105
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.840309 0.304078 -2.763 0.005719 **
## Starost 0.017331 0.004621 3.750 0.000177 ***
## SpolFaktorŽ -0.028637 0.082284 -0.348 0.727825
## AktivnostFaktorDA -0.195480 0.082442 -2.371 0.017735 *
## KadilecFaktorDA 0.523806 0.105126 4.983 6.27e-07 ***
## HolesterolFaktorDA -0.022019 0.084040 -0.262 0.793317
## ZdraviloFaktorZdravilo A -0.157124 0.109284 -1.438 0.150503
## ZdraviloFaktorZdravilo B -0.226464 0.097865 -2.314 0.020665 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3353.2 on 2420 degrees of freedom
## Residual deviance: 3301.7 on 2413 degrees of freedom
## AIC: 3317.7
##
## Number of Fisher Scoring iterations: 4exp(cbind(RO = fit2$coefficients, confint.default(fit2)))## RO 2.5 % 97.5 %
## (Intercept) 0.4315772 0.2378080 0.7832320
## Starost 1.0174816 1.0083081 1.0267387
## SpolFaktorŽ 0.9717694 0.8270325 1.1418365
## AktivnostFaktorDA 0.8224399 0.6997279 0.9666720
## KadilecFaktorDA 1.6884413 1.3740505 2.0747665
## HolesterolFaktorDA 0.9782215 0.8296633 1.1533804
## ZdraviloFaktorZdravilo A 0.8545979 0.6898249 1.0587291
## ZdraviloFaktorZdravilo B 0.7973478 0.6581805 0.9659411podatki$Napoved <- fitted(fit2)
head(podatki)## ID Zastoj Starost Spol Aktivnost Kadilec Holesterol Zdravilo
## 1 1 0 52 1 1 0 0 2
## 2 2 1 68 0 1 0 1 0
## 3 3 1 66 1 1 1 0 1
## 4 4 1 70 0 1 0 1 1
## 5 5 0 51 0 0 1 0 2
## 6 6 1 63 0 0 0 0 1
## ZastojFaktor SpolFaktor AktivnostFaktor KadilecFaktor
## 1 NE Ž DA NE
## 2 DA M DA NE
## 3 DA Ž DA DA
## 4 DA M DA NE
## 5 NE M NE DA
## 6 DA M NE NE
## HolesterolFaktor ZdraviloFaktor Napoved
## 1 NE Zdravilo B 0.4037897
## 2 DA Placebo 0.5301315
## 3 NE Zdravilo A 0.6097056
## 4 DA Zdravilo A 0.4995523
## 5 NE Zdravilo B 0.5844073
## 6 NE Zdravilo A 0.5235810podatki$Uvrstitev <- ifelse(podatki$Napoved < 0.5, "NE", "DA")
podatki$UvrstitevFaktor <- factor(podatki$Uvrstitev,
levels = c("NE", "DA"),
labels = c("NE", "DA"))
razvrst_tabela <- table(podatki$ZastojFaktor, podatki$UvrstitevFaktor)
razvrst_tabela##
## NE DA
## NE 596 572
## DA 496 757uvrstitev_fit2 <- (razvrst_tabela[1,1]+razvrst_tabela[2,2])/nrow(podatki)
uvrstitev_fit2## [1] 0.55886library(ggplot2)
ggplot(podatki, aes(x=Napoved, fill=ZastojFaktor))+
theme_linedraw() +
geom_histogram(position="fill", binwidth=0.1) +
scale_fill_grey() +
geom_vline(xintercept=0.50) +
labs(fill="Zastoj") +
ylab("Delež") +
xlim(0, 1)## Warning: Removed 14 rows containing missing values (geom_bar).